home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / numerm.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  2.7 KB  |  101 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;  (c) Copyright 1976, 1983 Massachusetts Institute of Technology      ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module numerm macro)
  13.  
  14. ;;; Macros for interface of lisp numerical routines to macsyma,
  15. ;;; for use with the functions in Maxsrc;Numer.
  16.  
  17. (defmacro make-array$ (&rest l)
  18.   ;I guess macsyma has to know the default "flonum" type... --gsb
  19.   #+Maclisp
  20.   `(*array nil 'flonum ,@l)
  21.   #+(or cl NIL) `(make-array (list ,@l) :element-type 'double-float)
  22.   )
  23.  
  24.  
  25. (defmacro make-array% (&rest l)
  26.   #+Maclisp
  27.   `(*array nil 'fixnum ,@l)
  28.   #+(or cl NIL)
  29.   `(make-array (list ,@l) :element-type 'fixnum)
  30.   )
  31.  
  32. (defmacro aref$ (&rest l)
  33.   #+Maclisp
  34.   `(arraycall flonum ,@l)
  35.   #+(or cl NIL)
  36.   `(aref (the (simple-array double-float) ,(car l)) ,@(cdr l))
  37.   #+(or Franz)
  38.   `(aref ,@l)
  39.   )
  40.  
  41. (defmacro aref% (&rest l)
  42.   #+Maclisp
  43.   `(arraycall fixnum ,@l)
  44.   #+(or cl NIL)
  45.   `(aref (the (simple-array fixnum) ,(car l)) ,@(cdr l))
  46. )
  47.  
  48. (defmacro free-array% (a)
  49.   #+Maclisp
  50.   `(*rearray ,a)
  51.   #+(OR Cl NIL)
  52.   ;; not useful to call return-array unless it is at end of area.
  53.   ;; programs do better to save arrays as a resource, this works
  54.   ;; in maclisp too.
  55.   a
  56.   )
  57. (defmacro free-array$ (a)
  58.   #+maclisp
  59.   `(*rearray ,a)
  60.   #+(OR Cl NIL)
  61.   a
  62.   )
  63.  
  64.  
  65. (DEFMACRO DEFBINDTRAMP$ (NARGS)
  66.   (LET ((BIND-TRAMP$ #-Multics (SYMBOLCONC 'bind-tramp nargs '$)
  67.              #+Multics (implode (mapcan 'exploden
  68.                         (list 'bind-tramp nargs '$))))
  69.     (TRAMP$ #-Multics (SYMBOLCONC 'tramp nargs '$)
  70.         #+Multics (implode (mapcan 'exploden (list 'tramp nargs '$)))))
  71. ;;;When Multics gets symbolconc the above conditionalization can be removed.
  72.     `(PROGN 'COMPILE
  73.        #-cl (IF (FBOUNDP 'SPECIAL) (SPECIAL ,TRAMP$))
  74.         (PROCLAIM (QUOTE (SPECIAL ,TRAMP$)))
  75.          (DEFMACRO ,BIND-TRAMP$ (F G &REST BODY)
  76.           `(LET ((,',TRAMP$))
  77.          (LET ((,F (MAKE-TRAMP$ ,G ,',NARGS)))
  78.            ,@BODY))))))
  79.  
  80. (DEFBINDTRAMP$ 1)
  81. (DEFBINDTRAMP$ 2)
  82. (DEFBINDTRAMP$ 3)
  83.  
  84. (defmacro fcall$ (&rest l)
  85.   #+Maclisp
  86.   `(subrcall flonum ,@l)
  87.   #+(OR Cl NIL)
  88.   `(funcall ,@l)
  89.   )
  90.  
  91. ;; Central location for some important declarations.
  92. #+Maclisp
  93. (IF (FBOUNDP 'flonum)
  94.     (FLONUM (GCALL1$ NIL NIL)
  95.         (GCALL2$ NIL NIL NIL)
  96.         (MTO-FLOAT NIL)
  97.         ))
  98.  
  99.  
  100.  
  101.